home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1994 June / 1994-06b.d64 / file drawer 4.5 (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  15KB  |  693 lines
  1. 1 poke53281,1:printchr$(14)"[147][151] [198][201][204][197] [196][210][193][215][197][210] 4.5 -- [193] [196][193][212][193][194][193][211][197] [205][193][206][193][199][197][210]"
  2. 2 print" [211]ave up to 300 records, 8 fields each."
  3. 3 print" [211][200][193][210][197][215][193][210][197]: [208]lease send $2 to author:    [211]. [202]. [212]akis"
  4. 4 print" 1900 [194]urkley [210]d.":print" [215]illiamston, [205][201] 48895":goto60000
  5. 5 dims$(300):lm=0
  6. 6 poke198,0:print"[147]":goto60005
  7. 7 poke198,0:goto60007
  8. 8 poke198,0:goto60008
  9. 9 read r$,r:fort=1tor:readf$(t):next
  10. 20 printchr$(14)chr$(8):poke53281,0:poke53280,0:print"[155]"
  11. 25 printchr$(14)chr$(8):poke53281,0:poke53280,0:print"[155]"
  12. 26 print"[147]v4.5          [198]ile [196]rawer:
  13. 27 [153]""[163](38[171][195](r$))[173]2)"or";:[129]l[178]1[164][195](r$):[153]"tan";:[130]l:[153]"^
  14. 28 printtab((38-len(r$))/2)"[221]"r$"[146][221]
  15. 29 [153][163](38[171][195](r$))[173]2)"/";:[129]l[178]1[164][195](r$):[153]"tan";:[130]l:[153]"exp
  16. 30 print"[158]     1) [211]can [210]ecords":print"     2) [211]earch
  17. 31 [153]"     3) atndd (NULL)ecord":[153]"     4) (NULL)ailing (NULL)abels (1st ascour ascields)"
  18. 32 [153]"     5) (NULL)eport ((NULL)ort)":[153]"     6) (NULL)atn(NULL)val (NULL)(NULL)str$atn(NULL)valwait (str$o peekefore (NULL)uitting)"
  19. 33 [153]"     7) str$isk str$irectory":[153]"     8) (NULL)uit
  20. 34 print"     [205]emory bytes available[146]:";fre(0)
  21. 36 poke198,0
  22. 37 getk$:ifk$=""then37
  23. 38 ifval(k$)<1orval(k$)>8then37
  24. 40 k=val(k$):onkgosub50,300,500,425,600,900,8000,47
  25. 45 goto 25
  26. 47 print"[147]"chr$(9):end
  27. 50 rem ----
  28. 51 rem scan
  29. 52 rem ----
  30. 55 input"[147][211]tart scan at which record";sc
  31. 57 ifsc=0thenreturn
  32. 58 print"[211]canning..."
  33. 60 gosub250
  34. 65 gosub100:ifabs(a)<scthen65
  35. 67 ifa$="end of data"thengosub250:goto25
  36. 70 gosub150
  37. 75 goto65
  38. 100 rem -----------
  39. 101 rem read record
  40. 102 rem -----------
  41. 105 reada$:reada
  42. 110 ifa$="[166]"thenreturn
  43. 112 ifa$="end of data"thenreturn
  44. 115 fort=1tor:reada$(t):next
  45. 120 return
  46. 150 rem --------------------
  47. 151 rem put record on screen
  48. 152 rem --------------------
  49. 153 e=0:ifa$="[166]"then print"[147][210]ecord "abs(a)" [197][205][208][212][217]":e=1:goto180
  50. 155 print"[147][158] [210]ecord: [155]"abs(a)""
  51. 160 fort=1tor:print"[158]"f$(t)": [155]";:printa$(t):next
  52. 165 print"[158]  1) [196]elete"
  53. 170 print"  2) [197]dit"
  54. 175 print"  3) [208]rint"
  55. 180 print"  4) [195]ontinue
  56. 185 [153]"  5) (NULL)ain (NULL)enu
  57. 188 getk$:ifval(k$)<1orval(k$)>5then188
  58. 190 ife=1thenifval(k$)<4then188
  59. 191 ifk$="1"thengosub200
  60. 192 ifk$="2"thengosub550
  61. 193 ifk$="3"thengosub350
  62. 194 ifk$="4"thenreturn
  63. 195 ifk$="5"then25
  64. 196 return
  65. 200 rem -------------
  66. 201 rem delete record
  67. 202 rem -------------
  68. 205 print"[144][147]":z=abs(a)*10+1000:printz"data"chr$(34)"[166]"chr$(34)","a
  69. 210 fort=z+1toz+r:printt:next:print"run"
  70. 215 print"[155][196]eleting [201]tem: "abs(a)"[144]"
  71. 220 rem ---------------
  72. 221 rem create new data
  73. 222 rem ---------------
  74. 225 iffre(0)<650then print"[147][196]atabase is full, new data not added!!!":goto230
  75. 227 goto245
  76. 230 print"[208]ress any key to continue."
  77. 235 getk$:ifk$=""then235
  78. 245 poke198,10:fort=0to9:poke631+t,13:next:end
  79. 250 rem -------
  80. 251 rem restore
  81. 252 rem -------
  82. 255 restore
  83. 257 readb$:ifb$<>"[220]"then257
  84. 259 return
  85. 300 rem ------
  86. 301 rem search
  87. 302 rem ------
  88. 303 sr=0
  89. 305 input"[147][211]earch for: ";sr$
  90. 310 gosub 250:rem restore
  91. 312 print"[211]earching..."
  92. 315 read a$,a
  93. 320 if a$="[166]"then315
  94. 325 if a$="end of data"then return
  95. 330 fort=1tor:reada$(t)
  96. 335 if left$(a$(t),len(sr$))=sr$thensr=1
  97. 340 next:ifsr=1thengosub150:rem screen
  98. 345 sr=0:goto315
  99. 350 rem ------------
  100. 351 rem print record
  101. 352 rem ------------
  102. 355 print"[208]repare [208]rinter."
  103. 365 print"1) [208]rint [197]ntire [210]ecord":print"2) [208]rint [205]ail [204]abel (1st 4 [198]ields)
  104. 367 [161]k$:[139]k$[178]""[167]367
  105. 368 [139]k$[178][199](13)[167][142]
  106. 369 [139]k$[178]"2"[167]400
  107. 370 [139]k$[179][177]"1"[167]367
  108. 375 [159]4,4,7:[157]4
  109. 380 [129]t[178]1[164]r:[152]4,a$(t):[130]
  110. 385 [152]4:[160]4:[142]
  111. 400 [143] -----------
  112. 401 [143] print label
  113. 402 [143] -----------
  114. 405 [153]"right$f your records are by last name, do youwant the last name at the end
  115. 406 print"of the top line of the label? y[146] or n"
  116. 407 getks$:ifks$=""then407
  117. 408 forx=1tolen(a$(1)):ifmid$(a$(1),x,1)=" "thenaa$=left$(a$(1),x):x=len(a$(1))
  118. 409 next:x=len(a$(1))-len(aa$):ifks$="y"thena$(1)=right$(a$(1),x)+" "+aa$
  119. 410 if fs=1thenreturn
  120. 412 open4,4,7:cmd4
  121. 415 fort=1to4:print#4,a$(t):next
  122. 420 print#4:close4:return
  123. 425 rem ------------
  124. 426 rem print labels
  125. 427 rem ------------
  126. 428 cj=1:print"[208]repare printer."
  127. 429 print"[205]ailing [204]abels consist of the first     four fields."
  128. 430 print"(e.g. [206]ame, [193]ddress, [195]ity, [211]tate)
  129. 433 [153]"right$f your records are by last name, do youwant the last name at the end
  130. 435 print"of the top line of the label? y[146] or n"
  131. 436 getks$:ifks$=""then436
  132. 437 ifks$=chr$(13)then449
  133. 438 gosub636:print"[200]old down '[211]' to stop printing."
  134. 440 gosub250
  135. 442 gosub100:ifa$="[166]"then442
  136. 444 geth$:ifh$="s"then449
  137. 446 ifa$="end of data"then449
  138. 447 iflm=1thenifleft$(a$(se),len(ns$))<>ns$then442
  139. 448 gosub408:goto442
  140. 449 lm=0:n$="":cj=0:return
  141. 500 rem ----------
  142. 501 rem add record
  143. 502 rem ----------
  144. 503 print"[147][197]nter new record number or press [210][197][212][213][210][206] to search for an empty record."
  145. 504 inputa:ifa<1then508
  146. 505 ifa>300then504
  147. 506 print"[147][158]([206][207][212][197]: [212]his will erase any current      record in this location.)"
  148. 507 goto515
  149. 508 print"[147][204]ooking for an empty record..."
  150. 509 restore
  151. 510 read a$
  152. 512 ifa$="end of data"thenprint"[147][196][193][212][193][194][193][211][197] [198][213][204][204]!":fort=1to3000:next:goto25
  153. 513 ifa$<>"[166]"then510
  154. 514 reada:print"[147]"
  155. 515 print"[212]ry not to use commas or colons in an"
  156. 520 print"entry, but if you must, begin line with quotation mark--("chr$(34)")"
  157. 522 print"[204]imit entries to 67 characters!"
  158. 525 print"[158][210]ecord: [155]"abs(a)"":fort=1tor:print"[158]"f$(t)":[155]";
  159. 527 inputd$(t):print
  160. 530 ifd$(1)=""thent=r:next:goto25
  161. 532 iflen(d$(1))>67thend$(1)="":print"[158][197]ntry too long, please redo.[155]":goto527
  162. 535 next:d$(0)="xx"+chr$(34)+","+str$(a):z=abs(a)*10+1000:k=0:print"[144][147]"
  163. 540 fort=ztoz+r:printt"data"chr$(34)d$(k):k=k+1:next:print "run"
  164. 545 print"[155][193]dding [201]tem: "abs(a)"[144]":goto220
  165. 550 rem ----
  166. 551 rem edit
  167. 552 rem ----
  168. 553 print"[147][210]ecord :"abs(a)"":fori=1tor:print"  "a$(i):next
  169. 555 print"[197]dit errors then press [210][197][212][213][210][206].":fort=1tor:inputa$(t)
  170. 560 next:a$(0)="xx"+chr$(34)+","+str$(a):z=abs(a)*10+1000:k=0:print"[144][147]"
  171. 565 fort=ztoz+r:printt"data"chr$(34)a$(k):k=k+1:next:print "run"
  172. 570 print"[155][205]aking corrections.[144]":goto220
  173. 597 rem ----
  174. 598 rem sort
  175. 599 rem ----
  176. 600 ifpeek(49152)=32then618
  177. 602 print"[147][204]oading sort program..."
  178. 604 i=49152
  179. 606 readck$:ifck$="[214]"then610
  180. 608 goto606
  181. 610 readso:ifso=256then616
  182. 612 pokei,so:i=i+1
  183. 614 goto610
  184. 616 restore
  185. 618 rem
  186. 620 print"[147][215]hich field do you want sorted?"
  187. 622 fori=1tor:printtab(5)i"[157]) "f$(i):next
  188. 624 poke198,0
  189. 626 getk$:ifk$=""then626
  190. 628 ifval(k$)<1orval(k$)>rthen624
  191. 630 f=val(k$)
  192. 632 ns$=f$(f)
  193. 636 lm=0:print"[196]o you want to specify a limitation?"
  194. 638 poke198,0
  195. 640 getk$:ifk$=""then640
  196. 641 ifk$="y"thengosub800
  197. 642 ifcj=1thenreturn
  198. 643 gosub7000
  199. 644 print"[147][211]orting.  [208]lease wait."
  200. 646 readc$
  201. 648 ifc$="end of data"then662
  202. 650 ifc$="xx"then654
  203. 652 goto646
  204. 654 readd:d=abs(d):forff=1tor:readff$(ff):ff$(ff)=ff$(ff)+"                    "
  205. 655 ff$(ff)=ff$(ff)+"                                  ":next
  206. 656 s$(d)=left$(ff$(f),w(0))+" "+left$(ff$(m(1)),w(1))+" "+left$(ff$(m(2)),w(2))
  207. 657 s$(d)=s$(d)+" "+left$(ff$(m(3)),w(3))
  208. 658 iflm=1thenifleft$(ff$(se),len(ns$))<>ns$thens$(d)=""
  209. 660 goto646
  210. 662 sys49152,d,s$(1)
  211. 663 fort=1to3:m(t)=0:next
  212. 664 print"[147]   [215]here do you want the list printed?"
  213. 666 printtab(7)"1. [211]creen      2. [208]rinter"
  214. 668 poke198,0
  215. 670 getk$:ifk$=""then670
  216. 671 ifval(k$)<1orval(k$)>2then668
  217. 672 o=val(k$)
  218. 673 ifo=1the